home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib07.dsk / TERRAPIN GRAPHICS.bas < prev    next >
Encoding:
BASIC Source File  |  1990-01-01  |  10.0 KB  |  248 lines
  1. 10  REM  *    TERRAPIN 3.6    *      * BY DAVID KRATHWOHL *
  2. 20  LOMEM: 16400: TEXT : HOME : GOSUB 2800: HGR : GOSUB 800
  3. 40  HOME :FC = FC +1: IF FC = 25  THEN FC =  FRE(1):FC = 0
  4. 45  VTAB 22: INPUT "WHAT DO YOU WANT THE TURTLE TO DO?      ";IN$
  5. 50 BP = 0:VC = 0:IV = 0:IC = 0:C = 0: ONERR  GOTO 280
  6. 60  IF IN$ = ""  THEN 40
  7. 70  IF  RIGHT$(IN$,1) = "."  THEN IN$ =  LEFT$(IN$,( LEN(IN$) -1))
  8. 80 I$ =  LEFT$(IN$,2)
  9. 90 KY =  PEEK( -16384): IF KY >127  THEN  POKE  -16368,0: GOTO 40
  10. 100  IF I$ = "FD"  THEN  GOSUB 400: GOSUB 500: GOSUB 1720: GOTO 300
  11. 110  IF I$ = "BK"  THEN B = 1: GOSUB 400: GOSUB 500: GOSUB 1720: GOTO 300
  12. 120  IF I$ = "RT"  THEN  GOSUB 400: GOSUB 600: GOSUB 1720: GOTO 300
  13. 130  IF I$ = "LT"  THEN LE = 1: GOSUB 400: GOSUB 600: GOSUB 1720: GOTO 300
  14. 140  IF  LEFT$(IN$,1) = ">"  THEN 1100
  15. 150  IF I$ = "DO"  THEN 1300
  16. 160  IF I$ = "//"  THEN D(C) = D(C) -1: GOTO 1470
  17. 170  IF I$ = "PU"  THEN DR = 0: GOSUB 1720: GOTO 300
  18. 180  IF I$ = "PD"  THEN DR = 1: GOSUB 1720: GOTO 300
  19. 190  IF I$ = "NT"  THEN T = 1: GOSUB 700: GOTO 300
  20. 200  IF I$ = "TU"  THEN T = 0: GOSUB 800: GOTO 300
  21. 210  IF I$ = "HO"  THEN  GOSUB 1600: GOTO 300
  22. 220  IF I$ = "CL"  THEN  GOSUB 1700: GOTO 40
  23. 225  IF I$ = "H+"  OR I$ = "H-"  OR I$ = "T+"  OR I$ = "T-"  OR I$ = "E+"  OR I$ = "E-"  OR I$ = "OF"  THEN  GOSUB 1720: GOTO 300
  24. 230  IF I$ = "FI"  THEN 2000
  25. 240  IF I$ = "ED"  THEN 1800
  26. 250  IF I$ = "QU"  THEN  TEXT : HOME : END 
  27. 260  IF I$ = "IN"  THEN IG = 1: GOSUB 400: GOTO 300
  28. 270  IF BP = 1  THEN ED$ = PI$(PI): TEXT : HOME : GOTO 1900
  29. 280  HOME : POKE 216,0: VTAB 22: PRINT "I DON'T UNDERSTAND ";IN$: GOSUB 2700: GOTO 40
  30. 299  REM  * PARSE INSTRUCTIONS *
  31. 300  FOR J = 1 TO ( LEN(IN$) -1)
  32. 310  IF  MID$ (IN$,J,1) = "."  THEN IN$ =  RIGHT$(IN$,( LEN(IN$) -J)): GOTO 60
  33. 320  NEXT J
  34. 330  GOTO 40
  35. 399  REM  * DETERMINE QUANTITY *
  36. 400  FOR J = 1 TO  LEN(IN$)
  37. 410  IF  MID$ (IN$,J,1) = "."  THEN QU =  VAL( MID$ (IN$,3,J -3)): GOTO 440
  38. 420  NEXT J
  39. 430 QU =  VAL( MID$ (IN$,3))
  40. 440  IF QU = 0  THEN  GOSUB 1500: GOTO 460
  41. 450  IF IG = 1  THEN IC = IC +1:IV = QU:IG = 0
  42. 460  IF RO = 1  AND (QU <0  OR QU >255)  THEN  HOME : VTAB 22: PRINT "THE TERRAPIN CAN'T ";IN$: GOSUB 2700: GOTO 40
  43. 470  RETURN 
  44. 499  REM  * MOVE TURTLE *
  45. 500  GOSUB 700
  46. 510  IF B = 1  THEN TU = 180 +TU
  47. 520 X1 = X + SIN(TU *CV) *QU +.00005:Y1 = Y - COS(TU *CV) *QU +.00005
  48. 530  IF X1 <9  OR Y1 <9  OR X1 >270  OR Y1 >139  THEN 580
  49. 540  IF DR = 0  THEN 555
  50. 550  HPLOT X,Y TO X1,Y1
  51. 555  IF B = 1  THEN TU = TU -180
  52. 560 B = 0:X = X1:Y = Y1
  53. 570  GOSUB 800: RETURN 
  54. 580  HOME : VTAB 22: PRINT "THE TURTLE WOULD BE OUT OF BOUNDS.      TRY A DIFFERENT MOVE.                  ": GOSUB 2700:X1 = X:Y1 = Y: IF B = 1  THEN B = 0:TU = TU -180
  55. 590  POP : GOSUB 800: GOTO 40
  56. 599  REM   * TURN TURTLE *
  57. 600  GOSUB 700
  58. 610  IF LE = 1  THEN QU = 360 -QU:LE = 0
  59. 620  IF  ABS(QU) >360  THEN QU =  INT((QU/360 - INT(QU/360)) *360.05) * SGN(QU)
  60. 630 TU = TU +QU: GOSUB 800: RETURN 
  61. 699  REM  * ERASE TURTLE *
  62. 700  IF T > = 1  THEN T = T +1: IF T >2  THEN  RETURN 
  63. 710  HCOLOR= 0
  64. 720  HPLOT X2,Y2: HPLOT X3,Y3: HPLOT X4,Y4: HPLOT X5,Y5: HPLOT X6,Y6
  65. 730  HCOLOR= 3
  66. 740  RETURN 
  67. 799  REM  * DRAW TURTLE *
  68. 800  IF T >1  THEN  RETURN 
  69. 810  GOSUB 900: RETURN 
  70. 899  REM  * TURTLE LOCATION *
  71. 900 WI = 6:TA = 7
  72. 910 X2 = X1 -( COS(TU *CV)) *WI:Y2 = Y1 -( SIN(TU *CV)) *WI
  73. 920 X3 = X1 +( SIN(TU *CV)) *TA:Y3 = Y1 -( COS(TU *CV)) *TA
  74. 930 X4 = X1 +( COS(TU *CV)) *WI:Y4 = Y1 +( SIN(TU *CV)) *WI
  75. 940 X5 = X2 +((X3 -X2)/2):Y5 = Y2 +((Y3 -Y2)/2)
  76. 950 X6 = X3 -((X3 -X4)/2):Y6 = Y3 -((Y3 -Y4)/2)
  77. 960  & BT = X2,Y2: & CT = X3,Y3: & DT = X4,Y4: & ET = X5,Y5: & FT = X6,Y6
  78. 970  IF BT = 1  THEN Y2 = 170
  79. 980  IF CT = 1  THEN Y3 = 170
  80. 990  IF DT = 1  THEN Y4 = 170
  81. 1000  IF ET = 1  THEN Y5 = 170
  82. 1010  IF FT = 1  THEN Y6 = 170
  83. 1020  HPLOT X2,Y2: HPLOT X3,Y3: HPLOT X4,Y4: HPLOT X5,Y5: HPLOT X6,Y6: RETURN 
  84. 1099  REM  * CHECK FOR PICTURE *
  85. 1100 PI = PI +1
  86. 1120  FOR J = 1 TO ( LEN(IN$) -1)
  87. 1130  IF  MID$ (IN$,J,1) = "."  THEN PI$(PI) =  LEFT$(IN$,J -1):IN$ =  RIGHT$(IN$,( LEN(IN$) -J)): GOTO 1160
  88. 1140  NEXT J
  89. 1150 PI$(PI) = IN$:IN$ = ""
  90. 1160  FOR I = 0 TO (PI -1)
  91. 1170  IF PI$(I) = PI$(PI)  THEN IN$ = FI$(I) +"." +IN$:PI = PI -1: GOTO 60
  92. 1180  NEXT I
  93. 1190  HOME : VTAB 22: PRINT "I DON'T KNOW HOW TO ";PI$(PI): PRINT : PRINT "PLEASE TELL ME HOW"
  94. 1200  GOSUB 2700
  95. 1210  HOME : VTAB 22: PRINT "TO ";PI$(PI);: INPUT " ";FI$(PI)
  96. 1220 IN$ = FI$(PI) +"." +IN$:BP = 1: GOTO 60
  97. 1299  REM  * REPEAT FUNC. (DO) *
  98. 1300 C = C +1
  99. 1310  FOR J = 1 TO  LEN(IN$)
  100. 1320  IF  MID$ (IN$,J,1) = "("  THEN 1350
  101. 1330  NEXT J
  102. 1340 C = C -1: GOTO 280
  103. 1350  FOR L =  LEN(IN$) TO 1  STEP  -1
  104. 1360  IF  MID$ (IN$,L,1) = ")"  THEN 1390
  105. 1370  NEXT L
  106. 1380 C = C -1: GOTO 280
  107. 1390  FOR L1 = J TO L
  108. 1400  IF  MID$ (IN$,L1,1) = ")"  THEN 1420
  109. 1410  NEXT L1
  110. 1420  IF L1 <L  THEN L = L1
  111. 1430 SA$(C) =  MID$ (IN$,J +1,L -J -1)
  112. 1440  IF L < LEN(IN$)  THEN SB$(C) =  MID$ (IN$,L +2): GOTO 1450
  113. 1445 SB$(C) = ""
  114. 1450 D(C) =  VAL( MID$ (IN$,3,J -3))
  115. 1460 IN$ = SA$(C) +".//": GOTO 60
  116. 1470  IF D(C) = 0  AND SB$(C) = ""  THEN C = 0: GOTO 40
  117. 1480  IF D(C) = 0  THEN IN$ = SB$(C):SB$(C) = "":C = C -1: GOTO 60
  118. 1490 IN$ = SA$(C) +".//": GOTO 60
  119. 1499  REM  * VARIABLE FUNCTION *
  120. 1500 VC = VC +1
  121. 1510 VA$(VC) =  MID$ (IN$,3,J -3)
  122. 1520  FOR L = 0 TO VC -1
  123. 1530  IF VA$(L) = VA$(VC)  THEN QU = VA(L) +IV *IC:VC = VC -1: GOTO 460
  124. 1540  NEXT L
  125. 1550  HOME : VTAB 22: PRINT "WHAT IS THE VALUE OF ";VA$(VC);: INPUT VA(VC)
  126. 1560 QU = VA(VC): RETURN 
  127. 1599  REM  * HOME *
  128. 1600  GOSUB 700:X = X1:Y = Y1:X1 = 139:Y1 = 79
  129. 1610  IF DR = 0  THEN 1630
  130. 1620  HPLOT X,Y TO X1,Y1
  131. 1630 TU = 0:X = X1:Y = Y1: GOSUB 800: RETURN 
  132. 1699  REM  * CLEAR (CL) *
  133. 1700  HGR :X = 139:Y = 79:X1 = X:Y1 = Y
  134. 1710 TU = 0:T = 0:DR = 1: GOSUB 800: RETURN 
  135. 1720  IF RO = 0  THEN  RETURN 
  136. 1725  IF I$ = "LT"  THEN QU = 360 -QU
  137. 1730 RI$ = I$ +" " + STR$(QU)
  138. 1735  IF I$ = "PU"  THEN RI$ = "P 0"
  139. 1740  IF I$ = "PD"  THEN RI$ = "P 1"
  140. 1745  IF I$ = "H+"  THEN RI$ = "H 1"
  141. 1750  IF I$ = "H-"  THEN RI$ = "H 0"
  142. 1755  IF I$ = "T+"  THEN RI$ = "T 1"
  143. 1760  IF I$ = "T-"  THEN RI$ = "T 0"
  144. 1765  IF I$ = "E+"  THEN RI$ = "E 1"
  145. 1770  IF I$ = "E-"  THEN RI$ = "E 0"
  146. 1775  IF I$ = "OF"  THEN RI$ = "O"
  147. 1780  PR# 7: PRINT RI$: PR# 0: RETURN 
  148. 1799  REM  * PICTURE EDITOR *
  149. 1800  TEXT : HOME 
  150. 1810  FOR J = 1 TO  LEN(IN$)
  151. 1820  IF  MID$ (IN$,J,1) = ">"  THEN 1850
  152. 1830  NEXT J
  153. 1840  GOTO 280
  154. 1850 ED$ =  MID$ (IN$,J)
  155. 1860  FOR I = 1 TO PI
  156. 1870  IF PI$(I) = ED$  THEN  HOME : GOTO 1900
  157. 1880  NEXT I
  158. 1890 IN$ = ED$: GOTO 1100
  159. 1900  INVERSE : PRINT : HTAB 10: PRINT "*  PICTURE EDITOR  *": NORMAL 
  160. 1910  PRINT : PRINT : INVERSE : PRINT "EDITING:";: NORMAL : PRINT ED$
  161. 1920  PRINT : INVERSE : PRINT "THE INSTRUCTIONS FOR THIS PICTURE ARE:": NORMAL 
  162. 1930  PRINT : PRINT FI$(I)
  163. 1940  INVERSE : VTAB 15: PRINT "WHAT SHOULD THEY BE?": NORMAL 
  164. 1950  VTAB 17: HTAB 2: PRINT FI$(I)
  165. 1960  VTAB 17: INPUT FI$(I)
  166. 1970 IN$ = "CL": GOTO 50
  167. 1999  REM  * FILING SYSTEM *
  168. 2000  TEXT : HOME :D$ =  CHR$(4): ONERR  GOTO 2640
  169. 2010  VTAB 5: PRINT "OPTIONS AVAILABLE:                                                                  <1> SAVE PICTURES TO A FILE             <2> RETRIEVE PICTURES FROM A FILE       <3> DELETE A FILE"
  170. 2020  PRINT "    <4> CATALOG AND INDEX FILES             <5> RETURN TO GRAPHICS MODE
  171. 2030  VTAB 22: PRINT  SPC( 40): VTAB 22: INPUT "TYPE THE NUMBER OF YOUR CHOICE. ";OP$:OP =  VAL(OP$)
  172. 2040  IF OP <1  OR OP >5  THEN 2030
  173. 2050  ON OP GOTO 2060,2190,2320,2380,2630
  174. 2060  IF PI = 0  THEN  HOME : VTAB 12: PRINT "THERE ARE NO PICTURES TO SAVE": GOSUB 2700: GOTO 2000
  175. 2070  GOSUB 2620
  176. 2080  HOME : VTAB 12: HTAB 15: FLASH : PRINT "SAVING": NORMAL 
  177. 2090  PRINT D$;"OPEN ";NA$
  178. 2100  PRINT D$;"DELETE ";NA$
  179. 2110  PRINT D$;"OPEN ";NA$
  180. 2120  PRINT D$;"WRITE ";NA$
  181. 2130  PRINT PI
  182. 2140  FOR I = 1 TO PI
  183. 2150  PRINT PI$(I): PRINT FI$(I)
  184. 2160  NEXT I
  185. 2170  PRINT D$;"CLOSE ";NA$
  186. 2180  GOTO 2000
  187. 2190  HOME : VTAB 5: INVERSE : PRINT "WARNING:": NORMAL 
  188. 2200  PRINT "RETRIEVING A FILE WILL DESTROY ANY      PICTURES YOU CURRENTLY HAVE IN MEMORY."
  189. 2210  PRINT : PRINT "IF YOU WISH TO CONTINUE, PRESS 'C'      PRESS ANY OTHER KEY TO RETURN TO FILE   ACCESS OPTIONS."
  190. 2220  INPUT K$
  191. 2230  IF K$ < >"C"  THEN 2000
  192. 2240  GOSUB 2620
  193. 2250  HOME : FLASH : VTAB 12: HTAB 14: PRINT "RETRIEVING": NORMAL 
  194. 2260  GOSUB 2500
  195. 2270 PI = NU
  196. 2280  FOR I = 1 TO PI
  197. 2290 PI$(I) = PX$(I):FI$(I) = FX$(I)
  198. 2300  NEXT I
  199. 2310  GOTO 2000
  200. 2320  GOSUB 2620
  201. 2330  PRINT : PRINT : INPUT "ARE YOU SURE? ";K$
  202. 2340  IF  LEFT$(K$,1) < >"Y"  THEN 2000
  203. 2350  HOME : FLASH : VTAB 12: HTAB 14: PRINT " DELETING ": NORMAL 
  204. 2360  PRINT D$;"DELETE ";NA$
  205. 2370  GOTO 2000
  206. 2380  HOME : PRINT "YOUR FILE ENTRIES ARE PRECEDED BY A "; CHR$(34);"T"; CHR$(34)
  207. 2390  PRINT D$;"CATALOG"
  208. 2400  PRINT : INVERSE : INPUT "DO YOU WANT TO SEE WHICH DRAWINGS ARE IN A CERTAIN FILE? ";K$: NORMAL 
  209. 2410  IF  LEFT$(K$,1) < >"Y"  THEN 2000
  210. 2420  GOSUB 2620
  211. 2430  HOME : VTAB 12: HTAB 14: FLASH : PRINT " SEARCHING ": NORMAL 
  212. 2440  GOSUB 2500
  213. 2450  HOME : FOR L = 1 TO NU
  214. 2460  PRINT PX$(L);": ";FX$(L)
  215. 2470  GOSUB 2600: PRINT 
  216. 2480  NEXT L
  217. 2490  GOSUB 2590: GOTO 2000
  218. 2500  PRINT D$;"OPEN ";NA$
  219. 2510  PRINT D$;"READ ";NA$
  220. 2520  INPUT NU
  221. 2530  FOR I = 1 TO NU
  222. 2540  INPUT PX$(I): INPUT FX$(I)
  223. 2550  NEXT I
  224. 2560  PRINT D$;"CLOSE ";NA$
  225. 2570  RETURN 
  226. 2580  GOSUB 2590: GOTO 2000
  227. 2590  VTAB 24: HTAB 5: INVERSE : PRINT "PRESS ANY KEY TO CONTINUE";: NORMAL 
  228. 2600  GET K$: IF K$ = ""  THEN 2600
  229. 2610  RETURN 
  230. 2620  HOME : VTAB 12: INPUT "FILE NAME? ";NA$: RETURN 
  231. 2630 IN$ = "CL": GOTO 60
  232. 2640  IF  PEEK(222) = 5  THEN  PRINT D$;"DELETE ";NA$
  233. 2650  HOME : POKE 216,0: VTAB 12: PRINT "CHECK YOUR FILE NAME AND TRY AGAIN.": GOSUB 2700: GOTO 2000
  234. 2699  REM  * TIME DELAY *
  235. 2700  FOR H = 1 TO 1000: NEXT H: RETURN 
  236. 2799  REM  * SET UP VARIABLES *
  237. 2800 TU = 0:X = 139:Y = 79:CV = 3.14159265/180:DR = 1: HCOLOR= 3
  238. 2810  DIM PI$(100): DIM FI$(100):PI = 0: DIM PX$(100): DIM FX$(100)
  239. 2820  POKE  -16301,0
  240. 2830  FOR J = 768 TO 806: READ K: POKE J,K: NEXT J
  241. 2840  DATA   32,227,223,133,133,132,134,169,208,32
  242. 2850  DATA   192,222,165,18,72,165,17,72,32,185
  243. 2860  DATA   246,32,17,244,165,48,49,38,240,2 
  244. 2870  DATA   169,1,168,32,1,227,76,91,218 
  245. 2880  POKE 1013,76: POKE 1014,0: POKE 1015,3
  246. 2890 X1 = X:Y1 = Y
  247. 2900  VTAB 12: INPUT "ARE YOU OPERATING A TERRAPIN TURTLE? ";K$: IF  LEFT$(K$,1) < >"Y"  THEN RO = 0: RETURN 
  248. 2910 RO = 1: PR# 7: PRINT "*": PR# 0: RETURN